home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / dired-sex.el.z / dired-sex.el
Encoding:
Text File  |  1998-05-21  |  5.4 KB  |  158 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;
  3. ;; File:          dired-sex.el
  4. ;; Dired Version: #Revision: 7.9 $
  5. ;; RCS:
  6. ;; Description:   Marking files according to sexpressions.  Sorry.
  7. ;; Created:       Wed Sep 14 01:30:43 1994 by sandy on ibm550
  8. ;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (provide 'dired-sex)
  12. (require 'dired)
  13.  
  14. (defvar dired-sexpr-history nil
  15.   "History of sexpr used to mark files in dired.")
  16.  
  17. ;;; Marking files according to sexpr's
  18.  
  19. (defmacro dired-parse-ls ()
  20.   ;; Sets vars
  21.   ;;                inode s mode nlink uid gid size time name sym
  22.   ;; (probably let-bound in caller) according to current file line.
  23.   ;; Returns t for succes, nil if this is no file line.
  24.   ;; Upon success, all variables are set, either to nil or the
  25.   ;; appropriate value, so they need not be initialized.
  26.   ;; Moves point within the current line to the end of the file name.
  27.   '(let ((bol (progn (beginning-of-line) (point)))
  28.      (eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  29.      (if (re-search-forward dired-re-month-and-time eol t)
  30.      (let ((mode-len 10)        ; length of mode string
  31.            (tstart (progn (goto-char (match-beginning 0))
  32.                   (skip-chars-forward " ")
  33.                   (point)))
  34.            (fstart (match-end 0))
  35.            pos)
  36.        (goto-char (1+ bol))
  37.        (skip-chars-forward " \t")
  38.        ;; This subdir had better have been created with the current
  39.        ;; setting of actual switches. Otherwise, we can't parse.
  40.        (cond
  41.         ((and (or (memq ?k dired-internal-switches)
  42.               (memq ?s dired-internal-switches))
  43.           (memq ?i dired-internal-switches))
  44.          (setq pos (point))
  45.          (skip-chars-forward "0-9")
  46.          (if (setq inode (and (/= pos (point)) (string-to-int
  47.                             (buffer-substring
  48.                              pos (point)))))
  49.          (progn
  50.            (skip-chars-forward " ")
  51.            (setq pos (point))
  52.            (skip-chars-forward "0-9")
  53.            (setq s (and (/= pos (point)) (string-to-int
  54.                           (buffer-substring
  55.                            pos (point))))))
  56.            (setq s nil)))
  57.         ((or (memq ?s dired-internal-switches)
  58.          (memq ?k dired-internal-switches))
  59.          (setq pos (point))
  60.          (skip-chars-forward "0-9")
  61.          (setq s (and (/= pos (point)) (string-to-int
  62.                            (buffer-substring
  63.                         pos (point))))
  64.            inode nil))
  65.         ((memq ?i dired-internal-switches)
  66.          (setq pos (point))
  67.          (skip-chars-forward "0-9")
  68.          (setq inode (and (/= pos (point)) (string-to-int
  69.                         (buffer-substring
  70.                          pos (point))))
  71.            s nil))
  72.         (t
  73.          (setq s nil
  74.            inode nil)))
  75.        (skip-chars-forward " 0-9") ; in case of junk
  76.        (setq mode (buffer-substring (point) (+ mode-len (point))))
  77.        (forward-char mode-len)
  78.        (setq nlink (read (current-buffer)))
  79.        (or (integerp nlink) (setq nlink nil))
  80.        (skip-chars-forward " ")
  81.        (setq uid (buffer-substring (point) (progn
  82.                          (skip-chars-forward "^ ")
  83.                          (point))))
  84.        (goto-char tstart)
  85.        (skip-chars-backward " ")
  86.        (setq pos (point))
  87.        (skip-chars-backward "0-9")
  88.        (if (= pos (point))
  89.            (setq size nil)
  90.          (setq size (string-to-int (buffer-substring (point) pos))))
  91.        (skip-chars-backward " ")
  92.        ;; if no gid is displayed, gid will be set to uid
  93.        ;; but user will then not reference it anyway in PREDICATE.
  94.        (setq gid (buffer-substring (point) (progn
  95.                          (skip-chars-backward "^ ")
  96.                          (point)))
  97.          time (buffer-substring tstart
  98.                     (progn
  99.                       (goto-char fstart)
  100.                       (skip-chars-backward " ")
  101.                       (point)))
  102.          name (buffer-substring
  103.                fstart
  104.                (or (dired-move-to-end-of-filename t)
  105.                (point)))
  106.          sym  (and (looking-at "[/*@#=|]? -> ")
  107.                (buffer-substring (match-end 0)
  108.                          eol)))
  109.        t)))) ; return t if parsing was a success
  110.  
  111.  
  112. (defun dired-mark-sexp (predicate &optional unflag-p)
  113.   "Mark files for which PREDICATE returns non-nil.
  114. With a prefix arg, unflag those files instead.
  115.  
  116. PREDICATE is a lisp expression that can refer to the following symbols:
  117.  
  118.     inode  [integer] the inode of the file (only for ls -i output)
  119.     s      [integer] the size of the file for ls -s output
  120.                  (ususally in blocks or, with -k, in KByte)
  121.     mode   [string]  file permission bits, e.g. \"-rw-r--r--\"
  122.     nlink  [integer] number of links to file
  123.     uid    [string]  owner
  124.     gid    [string]  group  (If the gid is not displayed by ls,
  125.                  this will still be set (to the same as uid))
  126.     size   [integer] file size in bytes
  127.     time   [string]  the time that ls displays, e.g. \"Feb 12 14:17\"
  128.     name   [string]  the name of the file
  129.     sym    [string]  if file is a symbolic link, the linked-to name, else nil.
  130.  
  131. For example, use
  132.  
  133.         (equal 0 size)
  134.  
  135. to mark all zero length files."
  136.   ;; Using sym="" instead of nil avoids the trap of
  137.   ;; (string-match "foo" sym) into which a user would soon fall.
  138.   ;; No! Want to be able look for symlinks pointing to the empty string.
  139.   ;; Can happen. Also, then I can do an (if sym ...) structure. --sandy
  140.   ;; Give `equal' instead of `=' in the example, as this works on
  141.   ;; integers and strings.
  142.   (interactive
  143.    (list
  144.     (read
  145.      (dired-read-with-history "Mark if (lisp expr): " nil
  146.                   'dired-sexpr-history))
  147.     current-prefix-arg))
  148.   (message "%s" predicate)
  149.   (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))
  150.     inode s mode nlink uid gid size time name sym)
  151.     (dired-mark-if (save-excursion
  152.              (and (dired-parse-ls)
  153.               (eval predicate)))
  154.            (format "'%s file" predicate)))
  155.   (dired-update-mode-line-modified t))
  156.  
  157. ;;; end of dired-sex.el
  158.